home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / UTILITY1 / MSWSRC35.ZIP / MATH.CPP < prev    next >
C/C++ Source or Header  |  1993-05-10  |  15KB  |  718 lines
  1. /*
  2.  *      math.c          logo math functions module              dvb
  3.  *
  4.  *    Copyright (C) 1989 The Regents of the University of California
  5.  *    This Software may be copied and distributed for educational,
  6.  *    research, and not for profit purposes provided that this
  7.  *    copyright and statement are included in all such copies.
  8.  *
  9.  */
  10.  
  11. #include "logo.h"
  12. #include "globals.h"
  13. #include <signal.h>
  14. #include <setjmp.h>
  15. #include <math.h>
  16.  
  17. #define isdigit(dig)    (dig >= '0' && dig <= '9')
  18.  
  19. int numberp(NODE *snd)
  20. {
  21.     int dl,dr, pcnt, plen;
  22.     char *p;
  23.  
  24.     if (is_number(snd)) return(1);
  25.  
  26.     snd = cnv_node_to_strnode(snd);
  27.     if (snd == UNBOUND) return(0);
  28.  
  29.     p = getstrptr(snd); plen = getstrlen(snd); pcnt = dl = dr = 0;
  30.     if (plen >= MAX_NUMBER) {
  31.     return(0);
  32.     }
  33.  
  34.     if (pcnt < plen && *p == '-')
  35.     p++, pcnt++;
  36.  
  37.     while (pcnt < plen && isdigit(*p))
  38.     p++, pcnt++, dl++;
  39.  
  40.     if (pcnt < plen && *p == '.') {
  41.     p++, pcnt++;
  42.     while (pcnt < plen && isdigit(*p))
  43.         p++, pcnt++, dr++;
  44.     }
  45.  
  46.     if (pcnt < plen && (dl || dr) && (*p == 'E' || *p == 'e')) {
  47.     p++, pcnt++;
  48.  
  49.     if (pcnt < plen && *p == '+' || *p == '-')
  50.         p++, pcnt++;
  51.  
  52.     while (pcnt < plen && isdigit(*p))
  53.         p++, pcnt++, dr++;
  54.     }
  55.  
  56.     if ((dl == 0 && dr == 0) || pcnt != plen)
  57.     return (0);
  58.     else
  59.     return (dr + 1);
  60. }
  61.  
  62. NODE *lrandom(NODE *arg)
  63. {
  64.     NODE *val;
  65.     long r;
  66.  
  67.     val = pos_int_arg(arg);
  68.     if (NOT_THROWING) {
  69. #ifdef bsd
  70.         r = (getint(val) == 0 ? 0 : random() % getint(val));
  71. #else
  72.         r = (getint(val) == 0 ? 0 : rand() % getint(val));
  73. #endif
  74.         val = newnode(INT);
  75.         setint(val, (FIXNUM)r);
  76.         return(val);
  77.     } else return(UNBOUND);
  78. }
  79.  
  80. NODE *lrerandom(NODE *arg)
  81. {
  82.     int seed=1;
  83.  
  84.     if (arg != NIL) {
  85.         seed = int_arg(arg);
  86.     }
  87.     if (NOT_THROWING) {
  88. #ifdef bsd
  89.         srandom((int)seed);
  90. #else
  91.         srand((int)seed);
  92. #endif
  93.     }
  94.     return(UNBOUND);
  95. }
  96.  
  97. jmp_buf oflo_buf;
  98.  
  99. #ifdef __ZTC__
  100. #define sig_arg 0
  101. void handle_oflo(int sig) {
  102. #else
  103. #define sig_arg 0 
  104. void handle_oflo(int sig) {
  105. #endif
  106.     longjmp(oflo_buf,1);
  107. }
  108.  
  109. #ifdef vax
  110. void allow_intov() {
  111.     long dummy;
  112.     register long *p = &dummy;
  113.  
  114.     p[2] |= 040;    /* Turn on IV enable in saved PSW (I hate the vax) */
  115. }
  116.  
  117. double infnan() {
  118.     longjmp(oflo_buf,1);
  119. }
  120. #endif
  121.  
  122. #ifdef sun
  123. int matherr(struct exception *x)
  124. {
  125.     if (x->type == UNDERFLOW) return(1);
  126.     longjmp(oflo_buf,1);
  127. }
  128. #endif
  129.  
  130. #ifdef mac
  131. FLONUM degrad = 0.017453292520;
  132. #else
  133. FLONUM degrad = 3.141592653589793227020265931059839203954/180.0;
  134. #endif
  135.  
  136. NODE *binary(NODE *args, char fcn)
  137. {
  138.     NODE *arg, *val;
  139.     BOOLEAN imode;
  140.     FIXNUM iarg, ival, oval, nval;
  141.     FLONUM farg, fval;
  142.     int sign, wantint=0;
  143.  
  144.     arg = numeric_arg(args);
  145.     args = cdr(args);
  146.     if (stopping_flag == THROWING) return UNBOUND;
  147.     if (nodetype(arg) == INT) {
  148.     imode = TRUE;
  149.     ival = getint(arg);
  150.     } else {
  151.     imode = FALSE;
  152.     fval = getfloat(arg);
  153.     }
  154.     if (args == NIL) {    /* one argument supplied */
  155.       if (imode)
  156.     switch(fcn) {
  157.       case '-': ival = -ival; break;
  158.       case '~': ival = ~ival; break;
  159.       case 's':
  160.       case 'c':
  161.       case 't':
  162.       case 'S':
  163.       case 'C':
  164.       case 'T':
  165.       case 'q':
  166.       case 'e':
  167.       case 'g':
  168.       case 'n':
  169.       case '/':
  170.         imode = FALSE;
  171.         fval = (FLONUM)ival;
  172.         break;
  173.     }
  174.       if (imode == FALSE) {
  175.        if (!setjmp(oflo_buf)) {
  176.     switch(fcn) {
  177.       case '-': fval = -fval; break;
  178.       case '/':
  179.         if (fval == 0.0)
  180.         err_logo(BAD_DATA_UNREC,arg);
  181.         else
  182.         fval = 1/fval;
  183.         break;
  184.       case '~': err_logo(BAD_DATA_UNREC,arg); break;
  185.       case 'c':
  186.         fval = 90.0 - fval;
  187.       case 's':
  188.         /* Kahan sez we can't just multiply any old
  189.          * angle by degrad, but have to get into the
  190.          * range 0-45 first */
  191.         sign = (fval < 0.0);
  192.         if (sign) fval = -fval;
  193. #ifndef unix
  194.         fval = fmod(fval,360.0);
  195. #else
  196.         fval = drem(fval,360.0);
  197. #endif
  198.         if (fval > 180.0) {
  199.         fval -= 180.0;
  200.         sign = !sign;
  201.         }
  202.         if (fval > 90.0) fval = 180.0 - fval;
  203.         if (fval > 45.0)
  204.         fval = cos((90.0-fval)*degrad);
  205.         else
  206.         fval = sin(fval*degrad);
  207.         if (sign) fval = -fval;
  208.         break;
  209.       case 't': fval = atan(fval)/degrad; break;
  210.       case 'S': fval = sin(fval); break;
  211.       case 'C': fval = cos(fval); break;
  212. //      case 's': fval = sin(fval*degrad); break;
  213. //      case 'c': fval = cos(fval*degrad); break;
  214.       case 'T': fval = atan(fval); break;
  215.       case 'q': fval = sqrt(fval); break;
  216.       case 'e': fval = exp(fval); break;
  217.       case 'g': fval = log10(fval); break;
  218.       case 'n': fval = log(fval); break;
  219.       case 'r':
  220.         fval += (fval < 0 ? -0.5 : 0.5);
  221.       case 'i':
  222. #ifdef vax
  223.         allow_intov();
  224. #else
  225.         if (fval > (FLONUM)MAXINT ||
  226.             fval < -(FLONUM)MAXINT)
  227.         handle_oflo(sig_arg);
  228. #endif
  229.         signal(SIGFPE, handle_oflo);
  230.         ival = (FIXNUM)fval;
  231.         imode = TRUE;
  232.         signal(SIGFPE, SIG_DFL);
  233.         break;
  234.     }
  235.        } else {    /* overflow */
  236.         if (fcn == 'r' || fcn == 'i') {
  237.           if (fval < 0.0)
  238.         fval = ceil(fval);
  239.           else
  240.         fval = floor(fval);
  241.         } else
  242.         err_logo(BAD_DATA_UNREC,arg);
  243.        }
  244.       }        /* end float case */
  245.     }        /* end monadic */
  246.     while (args != NIL && NOT_THROWING) {
  247.     arg = numeric_arg(args);
  248.     args = cdr(args);
  249.     if (stopping_flag == THROWING) return UNBOUND;
  250.  
  251.     if (nodetype(arg) == INT) {
  252.         if (imode) iarg = getint(arg);
  253.         else farg = (FLONUM)getint(arg);
  254.     } else {
  255.         if (imode) {
  256.         fval = (FLONUM)ival;
  257.         imode = FALSE;
  258.         }
  259.         farg = getfloat(arg);
  260.     }
  261.  
  262.     if (imode) {
  263.         oval = ival;
  264. #ifdef vax
  265.         allow_intov();
  266. #endif
  267.         signal(SIGFPE, handle_oflo);
  268.         if (setjmp(oflo_buf) == 0) {
  269.          switch(fcn) {
  270. #ifdef vax
  271.           case '+': ival += iarg; break;
  272.           case '-': ival -= iarg; break;
  273.           case '*': ival *= iarg; break;
  274. #else
  275.           case '-': iarg = -iarg;
  276.           case '+':
  277.         if (iarg < 0) {
  278.             nval = ival + iarg;
  279.             if (nval >= ival)
  280.             handle_oflo(sig_arg);
  281.             else ival = nval;
  282.         } else {
  283.             nval = ival + iarg;
  284.             if (nval < ival)
  285.             handle_oflo(sig_arg);
  286.             else ival = nval;
  287.         }
  288.         break;
  289. #endif
  290.           case '/':
  291.         if (iarg == 0)
  292.           err_logo(BAD_DATA_UNREC,arg);
  293.         else
  294.           if (ival % iarg != 0) {
  295.             imode = FALSE;
  296.             fval = (FLONUM)ival;
  297.             farg = (FLONUM)iarg;
  298.           }
  299.           else ival /= iarg;
  300.           break;
  301.           case '%':
  302.         ival %= iarg;
  303.         if ((ival < 0) != (iarg < 0))
  304.             ival += iarg;
  305.         break;
  306.           case '&': ival &= iarg; break;
  307.           case '|': ival |= iarg; break;
  308.           case '^': ival ^= iarg; break;
  309.           case 'a':
  310.           case 'l':
  311.         if (iarg < 0) {
  312.           if (fcn == 'a')
  313.             ival >>= -iarg;
  314.           else
  315.             ival = (unsigned)ival
  316.             >> -iarg;
  317.         } else
  318.           ival <<= iarg;
  319.         break;
  320. #ifndef vax
  321.           case '*':
  322.         if (ival < SAFEINT && ival > -SAFEINT &&
  323.             iarg < SAFEINT && iarg > -SAFEINT) {
  324.             ival *= iarg;
  325.             break;
  326.         }
  327.         wantint++;
  328. #endif
  329.           default: /* math library */
  330.         imode = FALSE;
  331.         fval = (FLONUM)ival;
  332.         farg = (FLONUM)iarg;
  333.          }
  334.         } else {    /* integer overflow detected */
  335.         imode = FALSE;
  336.         fval = (FLONUM)oval;
  337.         farg = (FLONUM)iarg;
  338.         }
  339.         signal(SIGFPE,SIG_DFL);
  340.     }
  341.     if (imode == FALSE) {
  342.       signal(SIGFPE,handle_oflo);
  343.       if (setjmp(oflo_buf) == 0) {
  344.         switch(fcn) {
  345.           case '+': fval += farg; break;
  346.           case '-': fval -= farg; break;
  347.           case '*':
  348.         fval *= farg;
  349. #ifndef vax
  350.         if (wantint) {
  351.             wantint = 0;
  352.             if (fval <= MAXINT && fval >= -MAXINT) {
  353.             imode = TRUE;
  354.             ival = fval;
  355.             }
  356.         }
  357. #endif
  358.         break;
  359.           case '/': if (farg == 0.0)
  360.               err_logo(BAD_DATA_UNREC,arg);
  361.             else
  362.               fval /= farg;
  363.             break;
  364.           case 't':
  365.         fval = atan2(farg,fval)/degrad;
  366.         break;
  367.           case 'T':
  368.         fval = atan2(farg,fval);
  369.         break;
  370.           case 'p':
  371.         fval = pow(fval,farg);
  372.         break;
  373.           default: /* logical op */
  374.         if (nodetype(arg) == INT)
  375.           err_logo(BAD_DATA_UNREC, make_floatnode(fval));
  376.         else
  377.           err_logo(BAD_DATA_UNREC,arg);
  378.         }
  379.       } else {    /* floating overflow de